home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / vision / programm / grafstar / listings / show.lst < prev   
Encoding:
File List  |  1994-09-22  |  8.1 KB  |  184 lines
  1. '
  2. ' SHOW.LST
  3. '
  4. ' Dies ist ein kleines Demo-Programm, mit welchem Sie sich im Speicher
  5. ' reservierte Bilder ansehen können. Sie können es als Programm starten
  6. ' (mit der Endung "PRG" oder vom GFABASIC-Interpreter aus) oder als
  7. ' Accessory, wobei Sie es dann mit einem gepatchtem Compiler übersetzen
  8. ' müssen (siehe ACCPATCH.LST).
  9. '
  10. ' Haben Sie das Programm gestartet, können Sie mit den Zifferntasten
  11. ' "1" - "9" jeweils das 1. - 9. reservierte Bild ansehen, vorrausgesetzt
  12. ' es wurden welche reserviert. Mit der "Esc"-Taste verlassen Sie das
  13. ' Programm wieder.
  14. '
  15. ' Ich wünsche Ihnen hiermit noch viel Spaß und Erfolg beim experimentieren
  16. ' mit diesem Programm.
  17. '
  18. '                                       Ihr Alexander Stork
  19. '                                                   (Autor)
  20. '
  21. If @Menu_acc                                    !Als ACC geladen?
  22.   Reserve 35000                                 !Speicher reservieren
  23.   @Menu_register(@Menu_ap.id,"  Show me something") !ACC eintragen
  24. Endif
  25. '
  26. Repeat
  27.   If @Menu_acc                                  !ACC?
  28.     Repeat                                      !Dann auf Message ...
  29.       @Evnt_mesag                               !warten.
  30.     Until @Evnt_mesag(0)=40                     !Verlasse bei '40'
  31.   Endif
  32.   '
  33.   @Memo_getadr(*Adresse%,*Anzahl%,*Ext%)        !Bildadresse etc. ermitteln
  34.   '
  35.   If Adresse%>0                                 !Schon Bilder angemeldet?
  36.     Sget Hgr$                                   !Hintergrund retten
  37.     Cls                                         !Clear Screen
  38.     Print At(10,4);"Drücken Sie eine Ziffer!"   !Eine kleine ...
  39.     Print At(10,5);"'Esc' = Ende ..."           !Info ausgeben
  40.     '
  41.     Do
  42.       I$=Inkey$                                 !Zeichen von Tastatur lesen ...
  43.       I%=Val(I$)                                !und Zahlwert ermitteln
  44.       '
  45.       Exit If I$=Chr$(27)                       !Verlasse DO-LOOP mit "Esc"
  46.       '
  47.       If Len(I$)                                !Ist ein Zeichen da?
  48.         If I%>=1 And I%<=Anzahl%                !Nur zulässige Werte
  49.           Dec I%
  50.           Bmove Adresse%+I%*32000,Xbios(3),32000  !Bild anzeigen
  51.         Else
  52.           Out 2,7                               !Fehleingabe: Klingel
  53.         Endif
  54.       Endif
  55.     Loop
  56.     '
  57.     Sput Hgr$                                   !Hintergrund restaurieren
  58.   Else
  59.     Alert 1,"Es sind momentan keine|Bilder im Speicher!",1,"   OK   ",Erg%
  60.   Endif
  61. Until @Menu_acc=0                               !Kein ACC -> zum Desktop
  62. '
  63. ' =============================================================================
  64. '                                 M E M O R Y                          12.05.89
  65. ' =============================================================================
  66. '
  67. ' Wollen Sie mit eigenen Programmen an die reservierten Bilder herankommen,
  68. ' können Sie dies mit folgenden Routinen ganz einfach tun.
  69. ' Diese Routinen wurden in GFABASIC 2.0 geschrieben, sollten aber in der
  70. ' Version 3.0 ebenfalls laufen.
  71. '
  72. ' Hier werden zunächst die einzelnen Routinen kurz dargestellt. Anschließend
  73. ' folgt dann deren Programmtext.
  74. '
  75. ' Bsp.1: @Memo_getadr(*Adresse%,*Anzahl%,*Ext%)
  76. '        Man erhält die Startadresse und die Anzahl der Bilder sowie
  77. '        eine Zusatzinformation (Integer, 2 Byte).
  78. '
  79. ' Bsp.2: @Memo_putadr(Adresse%,5,0)
  80. '        Falls Bilder reserviert wurden, können diese hier angemeldet werden.
  81. '        In diesem Fall befinden sich 5 Bilder ab Adresse 'Adresse%'.
  82. '        Als Zusatzinformation wird eine '0' übergeben.
  83. '
  84. ' Bsp.3: @Memo_putadr(Adresse%,12,-1)
  85. '        Es werden neue Werte für Adresse und Anzahl der Bilder gesetzt.
  86. '        Die Zusatzinfo bleibt unverändert. Wenn negative Werte übergeben
  87. '        werden, bleibt der jeweilige Parameter unverändert.
  88. '
  89. ' Bsp.4: @Memo_clradr
  90. '        So werden die Informationen des Infospeichers gelöscht, d.h. es
  91. '        werden die ersten zwei Bytes der Kennung gelöscht, so daß die
  92. '        restlichen Informationen von der Procedure Memo_getadr() nicht
  93. '        mehr erkannt werden.
  94. '
  95. ' So sieht das Format des 16 Byte langen Informationsspeichers aus. Er liegt
  96. ' hinter dem (phys.) Bildspeicher, also ab Xbios(2)+32000.
  97. '
  98. ' PICTUREvaaaannee = 16Bytes
  99. ' |      ||   | |
  100. ' |      ||   | erweiterte Information (z.Zt.=0): Wort/14
  101. ' |      ||   Anzahl der Bilder: Wort/12
  102. ' |      |Adresse des 1. Bildes: Langwort/8
  103. ' |      Format-Version (=0): Byte/7
  104. ' Kennung: 7 Byte String/0
  105. '
  106. ' Hier sind die Routinen zur Abfrage des Speichers:
  107. '
  108. Procedure Memo_getadr(Aptr.%,Nptr.%,Eptr.%)
  109.   Local Adresse.%,Info$,Adr.%,Num.%,Ext.%       !Lokale Variablen
  110.   '
  111.   Info$=Space$(7)                               !7-Byte-String vorbereiten
  112.   Adresse.%=Xbios(2)+32000                      !Adresse ermitteln
  113.   Bmove Adresse.%,Varptr(Info$),7               !Kennung in String kopieren
  114.   '
  115.   If Info$="PICTURE" And Peek(Adresse.%+7)=0    !Kennung und Version abfragen
  116.     Adr.%=Lpeek(Adresse.%+8)                    !Bildadresse ...
  117.     Num.%=Dpeek(Adresse.%+12)                   !Anzahl der Bilder ...
  118.     Ext.%=Dpeek(Adresse.%+14)                   !und Zusatzinformationen holen
  119.     '                                           !(-> ist zur Zeit unbenutzt)
  120.   Else
  121.     Adr.%=-1                                    !Bei falscher Kennung ...
  122.     Num.%=-1                                    !wird jeder Variable ...
  123.     Ext.%=-1                                    !'-1' übergeben
  124.     '
  125.   Endif
  126.   '
  127.   *Aptr.%=Adr.%                                 !Und nun alle ...
  128.   *Nptr.%=Num.%                                 !Werte über die Pointer ...
  129.   *Eptr.%=Ext.%                                 !zurückgeben
  130. Return
  131. Procedure Memo_putadr(Adr%,Num%,Ext%)
  132.   Local Adresse%,Kennung$                       !Lokale Variablen
  133.   '
  134.   Kennung$="PICTURE"                            !Kennungs-String definieren
  135.   Adresse%=Xbios(2)+32000                       !Adresse ermitteln
  136.   '
  137.   Bmove Varptr(Kennung$),Adresse%,7             !Kennung übertragen
  138.   '
  139.   If Adr%>=0
  140.     Lpoke Adresse%+8,Adr%                       !Adresse, ...
  141.   Endif
  142.   If Num%>=0
  143.     Dpoke Adresse%+12,Num%                      !Anzahl und ...
  144.   Endif
  145.   If Ext%>=0
  146.     Dpoke Adresse%+14,Ext%                      !Zusatzinfo setzen
  147.   Endif
  148. Return
  149. Procedure Memo_clradr
  150.   Local Adresse%                                !Lokale Variable
  151.   '
  152.   Adresse%=Xbios(2)+32000                       !Adresse ermitteln
  153.   '
  154.   Dpoke Adresse%,0                              !Kennung löschen
  155. Return
  156. ' =============================================================================
  157. '                                   M E N Ü                            12.05.89
  158. ' =============================================================================
  159. Deffn Menu_acc=(Lpeek(Basepage+&H24)=0)         !Ist '-1' wenn als ACC geladen
  160. Deffn Menu_ap.id=Dpeek(Lpeek(Gb+4)+4)           !Applikations-ID
  161. Procedure Menu_register(Ap.id%,Nam$)            !Appl.-ID und ACC-Name übergeben
  162.   Nam$=Nam$+Chr$(0)                             !Nullbyte anhängen
  163.   Bmove Varptr(Nam$),Basepage+192,Len(Nam$)     !String auf freien Speicher
  164.   '                                             !der Basepage schieben
  165.   '
  166.   Dpoke Gintin,Ap.id%                           !Appl.-ID übergeben
  167.   Lpoke Addrin,Basepage+192                     !String-Adresse übergeben
  168.   '
  169.   Gemsys 35                                     !AES-Routine ausführen
  170. Return
  171. ' =============================================================================
  172. '                                  E V E N T                           12.05.89
  173. ' =============================================================================
  174. Deffn Evnt_mesag(N%)=Dpeek(Evnt_buffer%+N%*2)   !Liest Event-Message-Buffer
  175. Procedure Evnt_mesag                            !Wartet auf ein "Event"
  176.   Erase Evnt_buffer%()                          !Eventbuffer ...
  177.   Dim Evnt_buffer%(3)                           !initialisieren (16 Bytes)
  178.   '
  179.   Evnt_buffer%=Varptr(Evnt_buffer%(0))          !Buffer-Adresse ermitteln ...
  180.   Lpoke Addrin,Evnt_buffer%                     !und an das AES übergeben
  181.   '
  182.   Gemsys 23                                     !AES-Routine ausführen
  183. Return
  184.